This script plots all sensor data in order to visualizes the measurements recorded throughout the tool function experiment. In this study the variable of interest is the Penetration depth
dir_in <- "../derived_data"
dir_out <- "../plots"
Raw data must be located in ~/../derived_data.
Formatted data will be saved in ~/../plots. The knit directory for this script is the project directory.
library(R.utils)
library(ggplot2)
library(tools)
library(tidyverse)
library(patchwork)
library(doBy)
library(ggrepel)
library(openxlsx)
data_file <- list.files(dir_in, pattern = "\\.Rbin$", full.names = TRUE)
md5_in <- md5sum(data_file)
info_in <- data.frame(file = basename(names(md5_in)), checksum = md5_in, row.names = NULL)
info_in
imp_data <- loadObject(data_file)
str(imp_data)
'data.frame': 114706 obs. of 10 variables:
$ Sample : chr "DAC3-2" "DAC3-2" "DAC3-2" "DAC3-2" ...
$ Raw_material : chr "Dacite" "Dacite" "Dacite" "Dacite" ...
$ Contact_material: chr "wood" "wood" "wood" "wood" ...
$ Stroke : num 1 1 1 1 1 1 1 1 1 1 ...
$ Step : num 1 2 3 4 5 6 7 8 9 10 ...
$ Force : num -58.8 -59.3 -61.6 -56.7 -58 ...
$ Friction : num -2.46 -9.88 -31.78 -53.99 -64.34 ...
$ Depth : num 13.8 13.8 13.6 13.3 13.1 ...
$ Position : num 260 263 297 356 387 ...
$ Velocity : num -0.0031 106.7299 502.972 551.2161 162.7834 ...
# replace "stroke" by "cycle"
colnames(imp_data)[colnames(imp_data) == "Stroke"] <- "Cycle"
The imported file is: “~/../derived_data/sampl.Rbin”
# calculates the absolute depths reached per sample
abs.depth <- function(x) {
noNA <- x[!is.na(x)]
out <- abs(min(noNA) - max(noNA))
}
# Define grouping variable and compute the summary statistics
depth <- summaryBy(Depth ~ Sample+Raw_material+Contact_material,
data=imp_data,
FUN=abs.depth)
str(depth)
'data.frame': 12 obs. of 4 variables:
$ Sample : chr "DAC3-2" "DAC3-4" "DAC3-6" "FLT10-2" ...
$ Raw_material : chr "Dacite" "Dacite" "Dacite" "Flint" ...
$ Contact_material: chr "wood" "wood" "wood" "wood" ...
$ Depth.abs.depth : num 2.94 2.5 2.91 2.88 3.89 ...
depth[["Contact_material"]] <- factor(depth[["Contact_material"]])
# plots all depth points in one facet plot (contact material together)
p3 <- ggplot(data = depth, aes(x = Contact_material,
y = Depth.abs.depth, colour =
Raw_material)) +
geom_point() + labs(y = "Absolute depth (mm)") +
facet_wrap(~Raw_material, strip.position = "bottom") +
# avoids overplotting of the labels (sample IDs)
geom_text_repel(aes(label=Sample), size = 2,
nudge_x = -0.4,
segment.size = 0.1, force = 2,
seed = 123) +
scale_y_continuous(trans = "reverse") +
scale_x_discrete(position ="top") +
# removes the "_" between "Contact_material in the legend
labs(x = "Contact material") +
theme_classic() +
theme(legend.position = "none")
print(p3)
# save to PDF
file_out <- paste0(file_path_sans_ext(info_in[["file"]]),
"_depth_a_plot_", ".pdf")
ggsave(filename = file_out, plot = p3, path = dir_out,
device = "pdf",
width = 25, height = 17, units = "cm")
depth[["Raw_material"]] <- factor(depth[["Raw_material"]])
# plots all depth points in one facet plot (contact material separated)
p4 <- ggplot(data = depth, aes(x = Contact_material,
y = Depth.abs.depth, colour =
Raw_material)) +
geom_point() + labs(y = "Absolute depth (mm)") +
# avoids overplotting of the labels (sample IDs)
geom_text_repel(aes(label=Sample), size = 2,
nudge_x = -0.4,
segment.size = 0.1, force = 2,
seed = 123) +
scale_y_continuous(trans = "reverse") +
scale_x_discrete(position ="top") +
# removes the "_" between "Contact_material in the legend
labs(x = "Contact material") +
theme_classic() +
theme(axis.text.x = element_blank(), axis.ticks = element_blank()) +
theme(legend.position = "none")
print(p4)
# save to PDF
file_out <- paste0(file_path_sans_ext(info_in[["file"]]),
"_depth_b_plot_", ".pdf")
ggsave(filename = file_out, plot = p4, path = dir_out,
device = "pdf",
width = 25, height = 17, units = "cm")
sp <- split(imp_data, imp_data[["Sample"]])
for (i in seq_along(sp)) {
# creates a sequence of every ~ 50th strokes
seq_st <- seq(1, length(unique(sp[[i]][["Cycle"]])), by = 40) %>%
c(max(unique(sp[[i]][["Cycle"]])))
dat_i_all <- sp[[i]] %>%
filter(Cycle %in% seq_st)
range_force_all <- range(dat_i_all[["Force"]])
range_friction_all <- range(dat_i_all[["Friction"]])
range_depth_all <- range(dat_i_all[["Depth"]])
range_velocity_all <- range(dat_i_all[["Velocity"]])
p1b <- ggplot(data = dat_i_all) +
geom_line(aes(x = Step, y = Force, colour = Cycle, group = Cycle), alpha = 0.3) +
labs(x = "Step", y = "Force [N]") +
scale_colour_continuous(trans = "reverse") +
coord_cartesian(ylim = range_force_all) +
scale_x_continuous(breaks=c(1, 4, 7, 10, 15, 20, 25)) +
theme_classic()
print(p1b)
p2b <- ggplot(data = dat_i_all) +
geom_line(aes(x = Step, y = Friction, colour = Cycle, group = Cycle), alpha = 0.3) +
labs(x = "Step", y = "Friction [N]") +
scale_colour_continuous(trans = "reverse") +
coord_cartesian(ylim = range_friction_all) +
scale_x_continuous(breaks=c(1, 4, 7, 10, 15, 20, 25)) +
theme_classic()
print(p2b)
p3b <- ggplot(data = dat_i_all) +
geom_line(aes(x = Step, y = Depth, colour = Cycle, group = Cycle), alpha = 0.3) +
labs(x = "Step", y = "Depth [mm]") +
scale_colour_continuous(trans = "reverse") +
coord_cartesian(ylim = range_depth_all) +
scale_x_continuous(breaks=c(1, 4, 7, 10, 15, 20, 25)) +
theme_classic()
print(p3b)
p4b <- ggplot(data = dat_i_all) +
geom_line(aes(x = Step, y = Velocity, colour = Cycle, group = Cycle), alpha = 0.3) +
labs(x = "Step", y = "Velocity [mm/s]") +
scale_colour_continuous(trans = "reverse") +
coord_cartesian(ylim = range_velocity_all) +
scale_x_continuous(breaks=c(1, 4, 7, 10, 15, 20, 25)) +
theme_classic()
print(p4b)
# patchwork plot
pb <- p1b + p2b + p3b + p4b + plot_annotation(title = names(sp)[i]) + plot_layout(ncol = 1, guides = "collect")
print(pb)
# save to PDF
file_out <- paste0(file_path_sans_ext(info_in[["file"]]), "_sensors_plot_",
names(sp)[i], ".pdf")
ggsave(filename = file_out, plot = pb, path = dir_out, device = "pdf")
}
# plots all strokes per sample divided by 40
# splits the data in the individual 24 samples
sp <- split(imp_data, imp_data[["Sample"]])
for (i in seq_along(sp)) {
# creates a sequence of every ~ 50th cycles
seq_st <- seq(1, length(unique(sp[[i]][["Cycle"]])), by = 40) %>%
c(max(unique(sp[[i]][["Cycle"]])))
dat_i_all <- sp[[i]] %>%
filter(Cycle %in% 1:500)
range_depth <- range(dat_i_all[["Depth"]])
p1 <- ggplot(data = dat_i_all, aes(x = Step, y = Depth, colour = Cycle)) +
geom_line(aes(group = Cycle), alpha = 0.3) +
labs(x = "Step", y = "Depth (mm)") + ylab(NULL) +
# reverses the legend starting with 0 going to 2000 strokes
scale_colour_continuous(trans = "reverse") +
coord_cartesian(ylim = range_depth) +
# changes the 'Step-number' in the x-legend
theme_classic()
# plots only the first 125 cycles per sample
dat_i_250 <- sp[[i]] %>%
# takes only the first 50 cycles per sample
filter(Cycle %in% 1:125)
range_depth <- range(dat_i_all[["Depth"]])
p2 <- ggplot(data = dat_i_250) +
geom_line(aes(x = Step, y = Depth, colour = Cycle, group = Cycle), alpha = 0.3) +
labs(x = "Step", y = "Depth (mm)") +
scale_colour_continuous(trans = "reverse") +
coord_cartesian(ylim = range_depth) +
theme_classic()
# plots only between 125 to 205 cycles per sample
dat_i_500 <- sp[[i]] %>%
# takes only the first 50 cycles per sample
filter(Cycle %in% 126:250)
range_depth <- range(dat_i_all[["Depth"]])
p3 <- ggplot(data = dat_i_500) +
geom_line(aes(x = Step, y = Depth, colour = Cycle, group = Cycle), alpha = 0.3) +
labs(x = "Step", y = "Depth (mm)") +
scale_colour_continuous(trans = "reverse") +
coord_cartesian(ylim = range_depth) +
theme_classic()
# plots only between 250 to 500 cycles per sample
dat_i_500 <- sp[[i]] %>%
# takes only the first 50 cycles per sample
filter(Cycle %in% 251:500)
range_depth <- range(dat_i_all[["Depth"]])
p4 <- ggplot(data = dat_i_500) +
geom_line(aes(x = Step, y = Depth, colour = Cycle, group = Cycle), alpha = 0.3) +
labs(x = "Step", y = "Depth (mm)") +
scale_colour_continuous(trans = "reverse") +
coord_cartesian(ylim = range_depth) +
theme_classic()
# patchwork plot
p <- p2 + p3 + p4 + p1 +plot_annotation(title = names(sp)[i])
print(p)
# save to PDF
file_out <- paste0(file_path_sans_ext(info_in[["file"]]), "_depth_plot_",
names(sp)[i], ".pdf")
ggsave(filename = file_out, plot = p, path = dir_out,
device = "pdf")
}
The files will be saved as “~/../plots.[ext]”.
| # Save data ## Write to XLSX (summary statistics) |
r write.xlsx(list(depth = depth, depth_good = depth_good), file = paste0(dir_out, file_out, ".xlsx")) |
Error in buildWorkbook(x, asTable = asTable, ...): object 'depth_good' not found |
sessionInfo()
R version 4.1.0 (2021-05-18)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19043)
Matrix products: default
locale:
[1] LC_COLLATE=English_United States.1252
[2] LC_CTYPE=English_United States.1252
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.1252
attached base packages:
[1] tools stats graphics grDevices utils datasets methods
[8] base
other attached packages:
[1] openxlsx_4.2.4 ggrepel_0.9.1 doBy_4.6.11 patchwork_1.1.1
[5] forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4
[9] readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 tidyverse_1.3.1
[13] ggplot2_3.3.5 R.utils_2.10.1 R.oo_1.24.0 R.methodsS3_1.8.1
loaded via a namespace (and not attached):
[1] Rcpp_1.0.7 lubridate_1.7.10 curry_0.1.1
[4] lattice_0.20-44 assertthat_0.2.1 digest_0.6.27
[7] utf8_1.2.1 R6_2.5.0 cellranger_1.1.0
[10] backports_1.2.1 reprex_2.0.0 evaluate_0.14
[13] highr_0.9 httr_1.4.2 pillar_1.6.1
[16] rlang_0.4.11 readxl_1.3.1 rstudioapi_0.13
[19] Matrix_1.3-3 rmarkdown_2.9 labeling_0.4.2
[22] munsell_0.5.0 broom_0.7.8 compiler_4.1.0
[25] Deriv_4.1.3 modelr_0.1.8 xfun_0.24
[28] microbenchmark_1.4-7 pkgconfig_2.0.3 htmltools_0.5.1.1
[31] tidyselect_1.1.1 fansi_0.5.0 crayon_1.4.1
[34] dbplyr_2.1.1 withr_2.4.2 MASS_7.3-54
[37] grid_4.1.0 jsonlite_1.7.2 gtable_0.3.0
[40] lifecycle_1.0.0 DBI_1.1.1 magrittr_2.0.1
[43] scales_1.1.1 zip_2.2.0 cli_3.0.1
[46] stringi_1.6.2 farver_2.1.0 fs_1.5.0
[49] xml2_1.3.2 ellipsis_0.3.2 generics_0.1.0
[52] vctrs_0.3.8 glue_1.4.2 hms_1.1.0
[55] yaml_2.2.1 colorspace_2.0-2 rvest_1.0.0
[58] knitr_1.33 haven_2.4.1
END OF SCRIPT